home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Source / Tools / Folds.Mod (.txt) < prev    next >
Oberon Text  |  1995-08-22  |  11KB  |  252 lines
  1. Syntax10.Scn.Fnt
  2. FoldElems
  3. Syntax10.Scn.Fnt
  4. (*----------------------------------------------------------------------
  5. Folds allows the compilation of folded texts automatically inserting error elements at the
  6. error positions.
  7. Folds.Compile  (^ | * | {filename} ~)
  8.     compiles the specified text(s). If the text contains folds, they are silently unfolded
  9.     before the compilation. Error elements are inserted at the error positions. They can
  10.     be searched for with Folds.ShowError. Old error elements are removed before every
  11.     new compilation and are not stored with Edit.Store. When called from the menu bar,
  12.     Folds.Compile compiles the text in the viewer to which the menu belongs.
  13. Folds.ShowError
  14.     Sets the caret to the next error element after the previous caret position and displays
  15.     an error message in the Log Viewer. If there is no caret set, ShowError shows the
  16.     first error in the text. If an error element is contained in a folded text part, the fold
  17.     is automatically expanded. ShowError expects a table of error numbers and error
  18.     messages in a specific file (OberonErrors.Text for default).
  19. Folds.Restore *
  20.     Collapses all folds that were unfolded during Folds.ShowErrors in the marked viewer.
  21. Folds.SetProfile
  22.     A couple of settings are stored in the file Folds.Profile which is read when module Folds
  23.     is loaded. When these settings are changed in Folds.Profile they can be reloaded with
  24.     the command Folds.SetProfile. The default contents of Folds.Profile (which are also the
  25.     default settings when Folds.Profile is missing) are as follows:
  26.         compiler = Compiler.Compile /s
  27.         errorFile = OberonErrors.Text
  28.         showWarnings = yes
  29.     The settings allow to select a different compiler, different default compilation options,
  30.     and a different error message file. They also specify if error elements should be inserted for
  31.     warnings.
  32. ----------------------------------------------------------------------*)
  33. Syntax10i.Scn.Fnt
  34. StampElems
  35. Alloc
  36. 30 Jun 95
  37. Syntax10b.Scn.Fnt
  38. Syntax10.Scn.Fnt
  39. Documentation
  40. MODULE Folds;    (* HM 
  41. IMPORT
  42.     Display, Input, Files, Fonts, Oberon, Texts, Viewers, TextFrames, MenuViewers, FoldElems;
  43. CONST
  44.     profile = "Folds.Profile";
  45.     unit = LONG(TextFrames.Unit);
  46.     left = 2; middle = 1; right = 0;
  47.     CR = 0DX;
  48.     ErrElem = POINTER TO ErrElemDesc;
  49.     ErrElemDesc = RECORD(Texts.ElemDesc)
  50.         err: INTEGER
  51.     END;
  52.     Options = ARRAY 16 OF CHAR;
  53.     w: Texts.Writer;
  54.     errT: Texts.Text;
  55.     compName, errFile: ARRAY 24 OF CHAR;
  56.     globOpt: Options;
  57.     showWarnings: BOOLEAN;
  58.     errors: INTEGER;
  59. PROCEDURE *NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);    
  60. END NoNotify;
  61. PROCEDURE *ErrCheck (e: Texts.Elem): BOOLEAN;    
  62. BEGIN RETURN e IS ErrElem
  63. END ErrCheck;
  64. PROCEDURE GetOptions (VAR s: Texts.Scanner; VAR opt: ARRAY OF CHAR);    
  65.     VAR i: INTEGER;
  66. BEGIN i := 0;
  67.     WHILE s.nextCh = " " DO Texts.Read(s, s.nextCh) END;
  68.     IF (s.nextCh = "/") OR (s.nextCh = "\") THEN
  69.         REPEAT opt[i] := s.nextCh; INC(i); Texts.Read(s, s.nextCh) UNTIL (CAP(s.nextCh) < "A") OR (CAP(s.nextCh) > "Z")
  70.     END;
  71.     opt[i] := 0X
  72. END GetOptions;
  73. PROCEDURE MarkedFrame (): TextFrames.Frame;    
  74.     VAR v: Viewers.Viewer; x: LONGINT;
  75. BEGIN v := Oberon.MarkedViewer();
  76.     IF (v # NIL ) & (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN RETURN v.dsc.next(TextFrames.Frame)
  77.     ELSE RETURN NIL
  78. END MarkedFrame;
  79. PROCEDURE OpenTempViewer (t: Texts.Text; VAR v: MenuViewers.Viewer);    
  80.     VAR x, y, h: INTEGER;
  81. BEGIN y := Display.Bottom; x := Display.Width-1; h := Viewers.minH; Viewers.minH := 1;
  82.     v := MenuViewers.New(TextFrames.NewMenu("", ""),
  83.  TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
  84.     Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
  85.     Viewers.minH := h
  86. END OpenTempViewer;
  87. PROCEDURE Show (f: TextFrames.Frame; pos: LONGINT);    
  88.     VAR end, delta: LONGINT;
  89. BEGIN delta := 200;
  90.     LOOP end := TextFrames.Pos(f, f.X + f.W, f.Y);
  91.         IF (f.org <= pos) & (pos < end) OR (f.org = end) THEN EXIT END;
  92.         TextFrames.Show(f, pos - delta); DEC(delta, 20)
  93. END Show;
  94. PROCEDURE *HandleErr (E: Texts.Elem; VAR msg: Texts.ElemMsg);    
  95.     VAR e: ErrElem; x, y, w, h: INTEGER; keys: SET;
  96. BEGIN
  97.     WITH E: ErrElem DO
  98.         WITH
  99.              msg: TextFrames.DisplayMsg DO
  100.                 IF ~msg.prepare THEN
  101.                     w := SHORT(E.W DIV unit); h := SHORT(E.H DIV unit);
  102.                     Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 1, w - 2, h-2, Display.replace)
  103.                 END
  104.         | msg: TextFrames.TrackMsg DO
  105.                 IF msg.keys = {middle} THEN
  106.                     REPEAT
  107.                         Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  108.                     UNTIL keys = {}
  109.                 END
  110.         | msg: Texts.CopyMsg DO
  111.                 NEW(e); Texts.CopyElem(E, e); e.err := E.err; msg.e := e
  112.         ELSE (*ignore it*)
  113.         END
  114. END HandleErr;
  115. PROCEDURE InsertErrElems (F: TextFrames.Frame; t: Texts.Text; pos: LONGINT);    
  116.     VAR S: Texts.Scanner; err: INTEGER; e: ErrElem;
  117. BEGIN errors := 0;
  118.     Texts.OpenScanner(S, Oberon.Log, pos); Texts.Scan(S);
  119.     LOOP S.line := 0;
  120.         IF S.eot THEN EXIT
  121.         ELSIF (S.class = Texts.Name) & (S.s = "pos") THEN Texts.Scan(S);
  122.             IF S.class = Texts.Int THEN pos := S.i ELSE EXIT END ;
  123.             REPEAT Texts.Scan(S) UNTIL S.eot OR (S.class = Texts.Int);
  124.             IF S.eot THEN EXIT
  125.             ELSIF showWarnings OR (S.i < 300) OR (S.i > 399) THEN
  126.                 NEW(e); e.W := Fonts.Default.height * unit; e.H := e.W;
  127.                 e.handle := HandleErr; e.err := SHORT(S.i);
  128.                 Texts.WriteElem(w, e); Texts.Insert(t, pos + errors, w.buf);
  129.                 INC(errors)
  130.             END
  131.         END ;
  132.         REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
  133. END InsertErrElems;
  134. PROCEDURE DeleteErrElems (t: Texts.Text);    
  135.     VAR r: Texts.Reader; pos: LONGINT;
  136. BEGIN Texts.OpenReader(r, t, 0);
  137.     LOOP Texts.ReadElem(r);
  138.         IF r.elem = NIL THEN EXIT
  139.         ELSIF r.elem IS ErrElem THEN
  140.             pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos-1)
  141.         END
  142. END DeleteErrElems;
  143. (*PROCEDURE ErrVisible (f: TextFrames.Frame): BOOLEAN;    
  144.     VAR end: LONGINT; r: Texts.Reader; e: Texts.Elem;
  145. BEGIN end := TextFrames.Pos(f, f.X + f.W, f.Y);
  146.     IF end + 1 = f.text.len THEN INC(end) END; 
  147.         -- ErrorElem inserted at f.text.len causes Pos to return the wrong position *)
  148.     Texts.OpenReader(r, f.text, f.org);
  149.     LOOP Texts.ReadElem(r);
  150.         IF (r.elem = NIL) OR (Texts.Pos(r) > end) THEN RETURN FALSE
  151.         ELSIF r.elem IS ErrElem THEN RETURN TRUE
  152.         END
  153. END ErrVisible;
  154. PROCEDURE GetErrMsg (err: INTEGER; VAR msg: ARRAY OF CHAR);    
  155.     VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
  156. BEGIN Texts.OpenScanner(s, errT, 0);
  157.     REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Int) & (s.i = 0);
  158.     WHILE ~ s.eot & ((s.class # Texts.Int) OR (s.i # err)) DO Texts.Scan(s) END;
  159.     IF ~s.eot THEN Texts.Read(s, ch); n := 0;
  160.         WHILE ~s.eot & (ch # CR) DO msg[n] := ch; INC(n); Texts.Read(s, ch) END;
  161.         msg[n] := 0X
  162. END GetErrMsg;
  163. PROCEDURE SetProfile*;    
  164.     VAR s: Texts.Scanner; t: Texts.Text; f: Files.File;
  165. BEGIN
  166.     compName := "Compiler.Compile"; errFile := "OberonErrors.Text"; globOpt := ""; showWarnings := TRUE;
  167.     f := Files.Old(profile);
  168.     IF f # NIL THEN NEW(t); Texts.Open(t, profile); Texts.OpenScanner(s, t, 0); Texts.Scan(s);
  169.         WHILE ~ s.eot DO
  170.             IF s.class = Texts.Name THEN
  171.                 IF s.s = "compiler" THEN
  172.                     Texts.Scan(s); Texts.Scan(s); COPY(s.s, compName);
  173.                     GetOptions(s, globOpt)
  174.                 ELSIF s.s = "errorFile" THEN
  175.                     Texts.Scan(s); Texts.Scan(s); COPY(s.s, errFile)
  176.                 ELSIF s.s = "showWarnings" THEN
  177.                     Texts.Scan(s); Texts.Scan(s);
  178.                     showWarnings := s.s = "yes"
  179.                 END
  180.             END;
  181.             Texts.Scan(s)
  182.         END
  183.     END;
  184.     errT := TextFrames.Text(errFile)
  185. END SetProfile;
  186. PROCEDURE Compile*;    
  187.     VAR f: TextFrames.Frame; t: Texts.Text; res: INTEGER; s: Texts.Scanner;
  188.         beg, end, time, pos: LONGINT; v: MenuViewers.Viewer; oldNotify: Texts.Notifier; par: Oberon.ParList;
  189.         ready: BOOLEAN; opt: Options;
  190. BEGIN
  191.     par := Oberon.Par;
  192.     Texts.OpenScanner(s, par.text, par.pos); 
  193.     REPEAT Texts.Scan(s); t := NIL; f := NIL; ready := FALSE;
  194.         IF par.vwr.dsc = par.frame THEN
  195.             f := par.frame.next(TextFrames.Frame);
  196.             Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y);
  197.             Oberon.FadeCursor(Oberon.Pointer);
  198.             t := f.text; opt := globOpt; ready := TRUE
  199.         ELSE
  200.             IF s.class = Texts.Name THEN t := TextFrames.Text(s.s)
  201.             ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
  202.                 f := MarkedFrame(); IF f # NIL THEN t := f.text END;
  203.                 ready := TRUE
  204.             ELSIF (s.class = Texts.Char) & (s.c = "^") THEN
  205.                 Oberon.GetSelection(t, beg, end, time);
  206.                 IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s); 
  207.                     IF s.class = Texts.Name THEN t := TextFrames.Text(s.s) END
  208.                 END
  209.             END;
  210.             GetOptions(s, opt)
  211.         END;
  212.         IF t # NIL THEN
  213.             DeleteErrElems(t);
  214.             oldNotify := t.notify; t.notify := NoNotify;
  215.             FoldElems.ExpandAll(t, 0, TRUE);
  216.             IF f = NIL THEN OpenTempViewer(t, v) ELSE DeleteErrElems(t) END;
  217.             par.text := TextFrames.Text(""); Texts.Write(w, "*"); Texts.WriteString(w, opt);
  218.             Texts.Append(par.text, w.buf); par.pos := 0; pos := Oberon.Log.len;
  219.             Oberon.Call(compName, par, FALSE, res);
  220.             IF (res = 0) & (f # NIL) THEN InsertErrElems(f, t, pos) END;
  221.             FoldElems.CollapseAll(t, {FoldElems.tempLeft});
  222.             IF f = NIL THEN
  223.                 Viewers.Close(v)
  224.             ELSE
  225.                 t.notify := oldNotify;
  226.                 IF errors # 0 THEN t.notify(t, Texts.replace, 0, t.len) END
  227.             END
  228.         END
  229.     UNTIL (t = NIL) OR ready
  230. END Compile;
  231. PROCEDURE ShowError*;    
  232.     VAR F: Display.Frame; pos: LONGINT; e: Texts.Elem; msg: ARRAY 128 OF CHAR;
  233. BEGIN
  234.     IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN F := Oberon.Par.frame.next
  235.     ELSE F := Oberon.FocusViewer.dsc.next
  236.     END;
  237.     WITH F: TextFrames.Frame DO
  238.         IF F.hasCar THEN pos := F.carloc.pos ELSE pos := 0 END;
  239.         FoldElems.FindElem(F.text, pos, ErrCheck, e);
  240.         IF e # NIL THEN pos := Texts.ElemPos(e);
  241.             Show(F, pos);
  242.             Oberon.PassFocus(Viewers.This(F.X, F.Y));
  243.             TextFrames.SetCaret(F, pos + 1);
  244.             GetErrMsg(e(ErrElem).err, msg);
  245.             Texts.WriteString(w, msg); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
  246.         END
  247.     ELSE
  248. END ShowError;
  249. BEGIN
  250.     Texts.OpenWriter(w); SetProfile
  251. END Folds.
  252.